00100		TITLE PFAIL; ********* JAN 12,77 *********
00200		INTERNAL PUTEXT,EXTOUT,GETEXT,EXTIN,FINEXT
00300		ENTRY LOOKF,LOOKX,LOOK,SHFTQ,SORT2,NORH,FNDEND,MINMAX
00400		ENTRY RLOOP,BLTEM,IFIX,FLOAT
00500	;;	ENTRY PFIBX,PFIB,RLOOP,BLTEM,IFIX,FLOAT
00600		ENTRY GETPTS,MOVIT,EXTEN,DBAR,QRN,SORT,SHIFT,SHFT1,SHFT0
00700		ENTRY PSHFT,ADRST,STAFF,RIGHT,RESTS,EXCHG,EXCH,SHRNK,EXPND,CLFNUM
00800		ENTRY SLRV,CLEFN,MMNN,CODEN,ZERO 
00900		EXTERNAL .COMM.,XRN,KJY,PTR,POSI,AMOD,KNR,NNP,PX,XXX,Q,SF,LLL
01000		EXTERNAL RCLF,STF,PTMOVE,IPG,JN,RCLF,MNX,ALOG,ENDL
01100	DEFINE ERROR (MSG)
01200	<	JSA 16,.ERROR
01300		JUMP [ASCIZ/MSG/
01400	]
01500	>
01600	
01700	.ERROR:	0
01800		OUTSTR [ASCIZ/?
01900	/]				;MAKE SURE HE CAN SEE HIS ERROR
02000		OUTSTR @(16)		;OUTPUT ERROR MESSAGE
02100		CALLI 1,12		;LET USER CONTI2UE
02200		JRA 16,1(16)
02300	
02400		CH←13
02500	
02600	REGS:	BLOCK 20
02700	
02800	;LOOK(<FILE>) FOR NO EXT., LOOKD() FOR .DAT, LOOKF() FOR .DMD
02900	LOOKF:	0
03000		MOVSI 0,'DMD'
03100		JRST LOOK1
03200	LOOKX:	0
03300		MOVE	0,@1(16)
03400		MOVEM 	0,FILNAM
03500		JSA 16, INTFIQ
03600		MOVE 0,DIR
03700		JRST LOOK1
03800	LOOK:	0
03900		MOVEI	0,0
04000	LOOK1:	MOVEM	0,DIR+1
04100		MOVE	0,@(16)
04200		MOVEM 	0,FILNAM
04300		JSA 16, INTFIQ
04400		SETZM	DIR+2
04500		SETZM	DIR+3
04600		LOOKUP	CH,DIR
04700		TDZA	0,0
04800		MOVNI	0,1
04900		JRA 16,1(16)
05000	
05100	INTFIQ:	0	;INITS DSK FOR INPUT
05200		MOVEI REGS
05300		BLT REGS+3
05400		INIT CH,17
05500		SIXBIT/DSK/
05600		0
05700		HALT .-3
05800	;	ERROR <CAN'T INIT DSK!>
05900		PUSHJ 17,INTF4
06000		JRA 16,0(16)
06100	
06200	INTF4:	MOVE 0,FILNAM#
06300		MOVEM 0,FN#
06400		MOVE 1,[POINT 7,FN]
06500	INTF3:	MOVE 2,[POINT 6,DIR]
06600		SETZM DIR
06700		MOVEI 3,5
06800	INTF1:	ILDB 0,1
06900		CAIN 0," "
07000		JRST INTF2
07100		SUBI 0,40
07200		IDPB 0,2
07300		SOJG 3,INTF1
07400	INTF2:	HRLZI REGS
07500		BLT 3
07600		POPJ 17,
07700	
07800	DIR:	BLOCK 4
07900	
08000	SHFTQ:	0		;CALL SHFTQ(R)
08100		MOVE JN+1	
08200		SOS
08300		SETZ 1,
08400		MOVE 3,@(16)	;R
08500	SHQ:	MOVE 2,XRN(1)
08600		FADRM 3,Q-1(2)
08700		CAMGE 1,0
08800		AOJA 1,SHQ
08900		JRA 16,1(16)
09000	
09100	SORT2:	0		;SUBROUTINE SORT2(RPOS,M)
09200		MOVEI	2,2	;DIMENSION RPOS(2,200)
09300	SO3:	MOVE	6,2	;(K=L HERE)
09400		SETO	11,	;L=2
09500		HRRZI	3,@(16)	;3	J=-1
09600		MOVE	4,2	;RX=RPOS(1,L-1)
09700		SUBI	4,1	;L-1
09800		IMULI	4,2
09900		ADDI	4,(3)
10000		MOVE	5,-2(4)	;RX
10100	SO2:	MOVE 	7,6	;	DO 2 K=L,M
10200					;IF(RPOS(1,K).GE.RX)GO TO 2
10300		IMULI	7,2	;IF(RPOS(1,K).GE.RX)GO TO 2
10400		ADDI	7,(3)
10500		CAMG	5,-2(7)
10600		JRST	SO1	; CONTINUE
10700		MOVE	5,-2(7)	;  RX=RPOS(1,K)
10800	;;C   WHY WERE ALL THE RX'S  JX ????? 9/6/73
10900		MOVE 	11,6	;J=K
11000	SO1:	CAMGE	6,@1(16)	;2	CONTINUE
11100		AOJA	6,SO2
11200		JUMPL	11,SO4	;IF(J)GO TO 4
11300		MOVE	12,2	;K=L-1
11400		SOS	12
11500		IMULI	12,2	;(K*2)
11600		ADD	12,3	;CALL EXCH(RPOS(1,K),RPOS(1,J))
11700		MOVE	10,-2(12)
11800		IMULI	11,2
11900		ADD	11,3
12000		EXCH	10,-2(11)
12100		MOVEM	10,-2(12)
12200		MOVE	10,-1(12)	;CALL EXCH(RPOS(2,K),RPOS(2,J))
12300		EXCH	10,-1(11)
12400		MOVEM	10,-1(12)
12500	SO4:	CAMGE	2,@1(16)	;4	L=L+1
12600		AOJA	2,SO3		;IF(L.LE.M)GO TO 3
12700		JRA	16,2(16)	;END
12800	
12900	NORH:	0 		;FUNCTION NORH(KK)
13000		MOVE 1,XRN+=499(15)  ;FIND VALUE IN NN ARRAY IN DO LOOP.
13100		MOVEM 1,@(16)		;KK=NN(K)
13200		SETZ 0,
13300		JUMPLE 1,NOR
13400		CAILE 1,2		;NORH=-1 IF KK≤0, >18, NOT 1,2,4,17.
13500		CAIN 1,4
13600		JRA 16,1(16)
13700		CAIE 1,=18		;USED IN RESPC.F4
13800		CAIN 1,=17
13900		JRA 16,1(16)
14000	NOR:	SETO 0,
14100		JRA 16,1(16)
14200	
14300	FNDEND:	0		;CALL FNDEND(R)
14400		SETZ 1,
14500	FA:	MOVE 2,XRN+=500(1)	;NN(K)
14600		JUMPLE 2,FB
14700		CAIG 2,3
14800		JRST FC
14900		CAIE 2,=17
15000		CAIN 2,=18
15100		SKIPA
15200	FB:	AOJA 1,FA	;ASSUMES IT WILL ALWAYS END PROPERLY!!!
15300	FC:	MOVN 2,XRN(1)	; MM(K)
15400		FADR 2,[2.0]
15500		FADR 2,ENDL   	;+ENDLN
15600	;;	FADR 2,RSP+=20	;+ENDLN
15700		MOVEM 2,@(16)
15800		JRA 16,1(16)
15900	
16000	MINMAX:	0	;	SUBROUTINE MINMAX(JRN)
16100		MOVE 1,(16)  ;COMMON /MNX/MIN,MAX,JT  DIM. JRN(1)
16200	;;	MOVE 1,0	;	COMMON /MNX/MIN,MAX,JT /XRN/JRN(1)
16300		MOVE 0,(1)	;GET FIRST VALUE OF CURRENT JRN ARRAY
16400		MOVE  3,
16500		MOVEI 2,2	;	MIN=10000
16600	;;MM:	CAMLE 0,XRN-1(2)	;	MAX=0
16700	MM:	CAMLE 0,1(1)    	;	MAX=0
16800		MOVE 0,1(1)     ;	DO 107 K=1,JT
16900		CAMGE 3,1(1)     	;	NN=JRN(K)
17000		MOVE 3,1(1)    	;	IF(NN.LT.MIN)MIN=NN
17100		AOJ 1,
17200		CAMGE 2,MNX+2
17300		AOJA 2,MM	;107	IF(NN.GT.MAX)MAX=NN
17400		MOVEM 0,MNX	;	END
17500		MOVEM 3,MNX+1
17600		JRA 16,1(16)
17700	
17800	PFIBX:	0	;DATA FIB/0.618/, RFIB/-.382/,ALG/0.30103/
17900			;100	ACCEPT 10,A   10	FORMAT(F)
18000		MOVE 12,@(16)		;PFIBX=14
18100		MOVE 13,[14.0]		;IF(A.EQ.1)GO TO 20
18200		CAMN 12,[1.0]		;Z=FIB
18300		JRST PFX		;IF(A.LT.1)Z=RFIB
18400		JSA 16,ALOG		;RH=ABS(ALOG(A)/ALOG(2.0))
18500		JUMP 12
18600		FDVR 0,[0.6931472]
18700		MOVM 11,0
18800		MOVE 10,[0.618]
18900		SKIPG    		;L=RH
19000		MOVN 10,[0.382]		;IF(L.EQ.0)GO TO 4
19100		KIFIX 7,11
19200		MOVE 6,7		;SAVE L FOR LATER
19300		JUMPE 6,PFZ
19400	PF:	MOVE 2,13		;	DO 3 K=1,L
19500		FMPR 2,10		;3	PFIBX=PFIBX+PFIBX*Z
19600		FADR 13,2
19700		SOJG 6,PF
19800	PFZ:	FLTR 7,7		;4	RH=RH-L
19900		FSBR 11,7		;IF(RH.EQ.0)GO TO 20
20000		JUMPE 11,PFX	
20100		MOVE 2,13
20200		FMPR 2,10
20300		FMPR 2,11		;PFIBX=PFIBX+PFIBX*Z*RH
20400		FADR 13,2
20500	PFX:	MOVE 0,13		;SEND BACK THE RESULT
20600		JRA 16,1(16)
20700	
20800	PFIB:	0		;FUNCTION PFIB(P)  PSEUDO-FIBONACCI RHYTHM SPACER
20900		MOVN 0,@(16)	;PFIB=(P+(.125-P)*(.8+.01*P))*50
21000		FADR 0,[0.125]	;END
21100		MOVE 1,@(16)
21200		FMPR 1,[0.02]
21300		FADR 1,[0.8]
21400		FMPR 0,1
21500		FADR 0,@(16)
21600		FMPR 0,[50.0]
21700		JRA 16,1(16)
21800	
21900	RLOOP:	0		;CALL RLOOP(A,B,K)
22000		HRLI 1,@1(16)	;DIMENSION A(1),B(1)  --  SOURCE
22100		HRRI 1,@(16)	;DO 1 J=1,K     -- DESTINATION
22200		MOVE 2,(16)    ;1	A(J)=B(J)  -- WORD COUNT
22300		ADD  2,@2(16)  ;LOC OF ARRAY A + WDCNT.
22400		BLT  1,-1(2)
22500		JRA 16,3(16)
22600	
22700	BLTEM: 	0
22800		HRLI 1,PX	;KWDS(...)=KPN(...)  PX IS LOC. OF KPN ARRAY
22900		HRRI 1,PTR	;RIGHT HALF IS LOC OF KWDS ARRAY
23000		MOVE 2,RCLF+3	;GET NUM. OF ITEMS  (RCLF+3=ITEM)
23100		BLT 1,PTR(2)	; PTR(2) IS WD CNT.   (ITEM+1)
23200		HRLI 1,Q	;RN(...)=Q(...)
23300		HRRI 1,XRN
23400		MOVE 2,POSI+=9	;THIS IS JPQ, NUM OF WDS.
23500		BLT 1,XRN-1(2)
23600		JRA 16,0(16)
23700	
23800	IFIX:	0
23900		KIFIX 0,@(16)
24000		JRA 16,1(16)
24100	FLOAT:	0
24200		FLTR 0,@(16)
24300		JRA 16,1(16)
24400	
24500	  K←15↔J←14↔ M←2↔ R2←5↔ X←6↔ L←4↔ R←7↔ A←11↔RY←3↔RZ←13↔JJ2←12
24600	
24700	; 	SUBROUTINE GETPTS
24800	;	COMMON/KNR/N(500) /NNP/NP(500)
24900	;XXX	COMMON/XRN/RN(4000)  /KJY/ K,J
25000	;	COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS
25100	;XXX	1/PTR/PWDS(250),ITEM,LL,I,IX
25200	;	EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
25300	;	1,(R6,RJQ(4))
25400	
25500	GETPTS:	0		;CALL GETPTS(N,RN,PWDS)
25600		SETZ	J,	;	J=0
25700		SETZ	K,	;	K=0
25800		MOVE 	JJ2,POSI+=8
25900		KIFIX	R2,.COMM.	;GET THE STAFF NUM. (NEG= ALL IN THIS PROG.)
26000		SETZ	X,
26100		MOVEI 	M,@2(16);	DO 1 M=1,ITEM
26200	G1:	AOJ	X,
26300		MOVE	L,(M)
26400		MOVEI 	R,@1(16)	;L=PWDS(M)
26500		ADDI	R,(L)		;IF(RTLINE(L))GO TO 1
26600	
26700		JUMPL R2,G9		;NEG R2=ALL STAVES
26800		KIFIX A,1(R)		;CHECK NOW FOR CORRECT STAFF
26900		CAME R2,A
27000		JRST GX			;NOT THE ONE.
27100	
27200	;*	MOVE	1,1(R)		;RN(L+2)
27300	;;NEVER USED IN 'PARTS'-	CAML	R2,[=5.0]
27400	;;	JRST	GZ
27500	;PT	MOVE A,1(R)
27600	;;	SKIPE IPG		;IF(IPG)GO TO GSTF
27700	;;	JRST GSTF
27800	;;	KIFIX A,A
27900	;;	FLTR A,A		;STAFF=IFIX(STAFF)  DROPS DECIS.
28000	;PT	SKIPL IPG
28100	;PT	JRST G9
28200	;PTGSTF:	CAME	R2,A   		;FINDS STAFF #
28300	;PT	JRST 	GX
28400	;;GZ:	MOVE	A,.COMM.+7		;RY=RN(L+1)
28500	;;	JUMPLE	A,G9			;F(R6.LE.0)GO TO 9
28600	;;	CAME	A,(R)		;IF(R6.NE.RY)GO TO 1
28700	;;	JRST	GX
28800	;  CHECK CODE NUM
28900	G9:	MOVE	A,2(R)
29000		CAMG	A,.COMM.+6	;R5  9	IF(OUTLIM(R4,R5,RN(L+3)))GO TO 2
29100		CAMGE	A,.COMM.+5	;R4
29200		JRST	G2
29300	
29400		SKIPG	JJ2
29500		MOVE	JJ2,X
29600		MOVE	.COMM.+=8	;IF(IPG)RN(L+2)=R7
29700		AOJ	J,
29800	;  IN LIMITS?
29900	;	MOVEI	A,XRN+=2498	;J=J+1
30000	;;	MOVEI	A,KNR-1
30100	;;	ADDI	A,(J)
30200		MOVEI	0,(L)
30300		AOJ	K,		;K=K+1
30400	;;	MOVEI	1,NNP-1
30500	;;	ADDI	1,(K)		;NP(K)=L
30600		MOVEM	0,NNP-1(K)
30700		ADDI	0,3		;N(J)=L+3
30800		MOVEM	0,KNR-1(J)
30900	;  NP IS FOR USE IN JUSTIFY ROUTINE
31000	G2:	KIFIX	RY,(R)	;2	IF(RY.LT.4)GO TO 1
31100		CAIN	RY,2   	;IF(RY.EQ.2)GO TO GRST
31200		JRST GRST
31300		CAIGE	RY,4
31400		JRST	GX
31500		MOVE	RZ,-1(R)	;RZ=RN(L)     WD CNT
31600		CAIE	RY,=44	;CODE 4 IS SOMETIMES =44
31700		JRST .+4
31800		CAMG RZ,[2.0]	  ;IF(RZ.LE.2)THEN IT'S AN CODE 44 BAR LINE.
31900		JRST GX
32000		JRST	G5		;FOUND A LINE
32100		CAILE	RY,7
32200		JRST	GX		;IF(RY.GT.7)GO TO 1
32300	;  TWO-ENDED ITEM?
32400	;;	CAMN	RY,[=4.0]	;GO TO(4,5,6,7),IFIX(RY)-3
32500	;;	JRST	G4
32600	;;	CAMN	RY,[=5.0]
32700	;;	JRST	G5
32800	;;	CAMN	RY,[=6.0]
32900	;;	JRST	G6
33000	;;	CAMG	RZ,[=4.0]	;4	IF(RZ.GT.2)GO TO 5
33100	;;	JRST	G5		; THERE IS A TRILL WIGGLE
33200	;;	JRST	GX		;GO TO 1   -- NO WIGGLE (P7≠0)
33300		XCT TBL-4(RY)	; NEXT REPLACES THE ABOVE.
33400		JRST G5
33500		JRST GX
33600	TBL:	JRST G4
33700		JRST G5
33800		JRST G6
33900		CAMG RZ,[4.0]
34000	
34100	G4:	CAMG	RZ,[=3.0]	;7	IF(RZ.GT.3)GO TO 5
34200		JRST	GX
34300		JRST	G5		;GO TO 1
34400	GRST:	MOVE RZ,-1(R)		;FOR 'CENTERED' RESTS
34500		JRST G8
34600	G6:	CAMGE	RZ,[=8.0]	;6	IF(RZ.LT.8)GO TO 8
34700		JRST	G8
34800		SKIPL 6(R)	;IF(R7)GO TO 8
34900		SKIPN =9(R)	;IF(R10.EQ.0)GO TO 8
35000		JRST	G8
35100	;;	MOVE	A,7(R)	  ; IF(OUTLIM(R4,R5,RN(L+8)))GO TO 8
35200	;;	JUMPE A,G5	;IF(R8.EQ.0)GO TO G5(MOVE ONLY P3,6)
35300		SKIPG A,7(R)		;IGNORE P8 IF IT IS 0 OR -
35400		JRST G8
35500		CAMG	A,.COMM.+6
35600		CAMGE	A,.COMM.+5
35700		JRST	G8
35800		CAMLE JJ2,X
35900		MOVE	JJ2,X
36000		AOJ	J,    ;  IN LIMITS?
36100		MOVEI	0,=8(L)		;J=J+1
36200		MOVEM 0,KNR-1(J)
36300	G8:	CAML	RZ,[=7.0]	;8	IF(RZ.LT.7)GO TO 5
36400		SKIPG A,8(R)	; R9	IF(R9.LE.0)GO TO G5
36500		JRST G5
36600		CAIE RY,2	;IF(RY.EQ.2)GO TO GRST2  (NEW CENTERED RESTS)
36700		SKIPE 7(R)	; R8
36800		JRST GRST2
36900		SKIPL 6(R)	; R7
37000		JRST G5
37100	GRST2:	CAMG	A,.COMM.+6
37200		CAMGE	A,.COMM.+5	;R4
37300		JRST	G5
37400	
37500		CAMLE JJ2,X
37600		MOVE	JJ2,X
37700		AOJ	J,		;J=J+1   ;  IN LIMITS?
37800		MOVEI	0,=9(L)
37900		MOVEM 0,KNR-1(J)	;N(J)=L+9
38000	G5:	CAIN	RY,2   	;IF(RY.EQ.2)GO TO GX  
38100		JRST GX  
38200		MOVE	A,5(R)
38300		CAMG	A,.COMM.+6
38400		CAMGE	A,.COMM.+5	;R4
38500		JRST	GX
38600	
38700		CAMLE JJ2,X
38800		MOVE	JJ2,X
38900		AOJ	J,     ;  IN LIMITS?
39000	;|	MOVEI	A,XRN+=2498	;J=J+1
39100	;;	ADDI	A,(J)
39200		MOVEI	0,6(L)  ;5	IF(OUTLIM(R4,R5,RN(L+6)))GO TO 1
39300	;;	ADDI	0,6		;N(J)=L+6
39400		MOVEM	0,KNR-1(J)
39500	;;GX:	CAMGE	X,PTR+=250	;1	CONTINUE
39600	GX:	CAMGE	X,LLL		;1	CONTINUE
39700		AOJA	M,G1
39800		MOVEM	JJ2,POSI+=8
39900		MOVEM	J,KJY+1
40000		MOVEM	K,KJY
40100		JRA	16,3(16)
40200	
40300	;	SUBROUTINE MOVIT(RN,NP,R4,R5,R8,R9)
40400	;	DIMENSION  NP(1),RN(1)
40500	;	COMMON  /KJY/ DONT,J
40600	MOVIT:	0		;RDIS=(R9-R8)/(R5-R4)
40700		MOVE	R,@5(16)    
40800		FSBR	R,@4(16)    
40900		MOVE	RY,@3(16)   
41000		FSBR	RY,@2(16)   
41100		FDVR	R,RY
41200	;	MOVEI	L,XRN+=2499	;	DO 1 K=1,J
41300		MOVE	L,1(16)	; GET NP ARRAY LOC
41400		SETZ	K,
41500		MOVE	0,@5(16)     	; SET UP R9
41600	;;M1:	MOVE	X,L	       ;	L=NP(K)
41700	M1:	MOVEI  	R2,@(16)	;RA=RN(L)
41800		ADD 	R2,(L)
41900		MOVEI	RZ,(R2)
42000		MOVE	R2,-1(R2)
42100		CAML	R2,@2(16)   	;IF(OUTLIM(R4,R5,RA))GO TO 1
42200		CAMLE	R2,@3(16)   
42300		JRST	MX
42400		JUMPE	0,M2	;IF(R9.NE.0)RA=(RA-R4)*RDIS
42500		FSBR	R2,@2(16)   
42600		FMPR	R2,R 
42700	M2: 	FADR	R2,@4(16)    	;	RN(L)=R8+RA
42800		MOVEM	R2,-1(RZ)
42900	MX:	AOJ	K,		;1	CONTINUE
43000		CAMGE	K,KJY+1
43100		AOJA	L,M1
43200		JRA	16,6(16)
43300	
43400	
43500	EXTEN:	0	;FUNCTION EXTEN(X)
43600		HRRM	16,.+2
43700		JSA	16,AMOD	;EXTEN=AMOD(X,1.)*10.
43800		JUMP 	@0
43900		JUMP	[=1.0]
44000		FMPR	[=10.0]
44100		JRA	16,1(16)
44200	
44300	DBAR:	0	; CALL DBAR(K,ITEM,J)
44400		MOVE 4,@2(16)	; -J-RR=RN(J+3)
44500	;PT	SKIPL IPG		;IF(IPG.GE.0)LEAVE BAR ALONE!
44600		JRST DB1
44700	;PT	KIFIX 2,XRN+3(4)		; -RN(J+4)-
44800		        		;KZ=RN(J+4)/100.
44900	;PT	IMULI 2,=100		;RN(J+4)=1.+KZ*100.
45000	
45100	DB1:	MOVE 1,@1(16)
45200		MOVE 7,XRN+2(4)		; -RR-
45300		MOVE 4,@(16)	;	DO 82 KY=K+1,ITEM
45400	DB:	MOVE 5,PTR(4)	;KZ=PWDS(KY)
45500		MOVE 6,XRN(5)	;	IF(RN(KZ+1).NE.4)GO TO 82
45600		CAME 6,[4.0]
45700		JRST DB82
45800		MOVE 6,XRN-1(5)	;IF(RN(KZ).GT.3)GO TO 82
45900		CAMLE 6,[3.0]
46000		JRST DB82
46100	;;C  AVOIDS DUPLICATE BARS.
46200		MOVN 6,XRN+2(5)  ;IF(ABS(RR-RN(KZ+3)).GT..5)GO TO 82	
46300		FADR 6,7
46400		SKIPGE 6
46500		MOVNS 6
46600		CAMLE 6,[0.5]
46700		JRST DB82
46800		MOVE 6,[99.0]  ;RN(KZ+2)=99
46900		MOVEM 6,XRN+1(5)
47000		SETZM XRN(5)	;RN(KZ+1)=0
47100	DB82:	AOJ 4,  ;82	CONTINUE
47200		CAIGE 4,(1)
47300		JRST DB
47400		MOVEM 7,SHFT1	; RR   SAVES IT FOR ADRST ROUTINE
47500		JRA 16,3(16)
47600	
47700	QRN:	0	; CALL QRN(J,XWDS,K)
47800		MOVE 4,@(16)	;810	JA=PWDS(K+1)
47900	
48000	PN4:	MOVE 5,@2(16)	;	DO 7 KY=J,JA-1
48100		MOVE 5,PTR(5)		; - JA -
48200		MOVE 6,XXX	;	PN(LK)=RN(KY)
48300		MOVEI 1,(6)		; SAVE IT FOR A LITTLE LATER
48400	PN:	MOVE 7,XRN-1(4)	;7	LK=LK+1
48500		MOVEM 7,Q-1(6)
48600		AOJ 4,			;AC4 IS KY, AC6 IS LK
48700		CAME 4,5
48800		AOJA 6,PN
48900		SKIPN SF		;IF(KL.EQ.0)GO TO PN5
49000		JRST PN5
49100		MOVE [1.0]		;PUT A 1.0 AS RHYTHM FOR REST OR NOTE
49200		ADD 6,SF
49300		MOVEM Q-1(6)		;PUT IT IN PARAM 7 OR 9
49400	PN5:	AOJ 6,
49500		MOVE 2,.COMM.+6		;	IF(R5)GO TO 6666
49600		JUMPL 2,PN2	;	IF(PN(J).EQ.2)LK=LK+1
49700		MOVEM 2,Q+4(1)		;	PN(J+5)=R5
49800		MOVE 3,[3.0]
49900	PN3:	MOVE 4,3		; IS THE WDCNT BIG ENOUGH?
50000		FSBR 4,Q-1(1)
50100		KIFIX 4,4
50200		ADD 6,4		; UPDATE THE MAIN COUNTER
50300	;PT???	SETZM Q+3(1)	; ZERO PARAM 4, THE VERTICAL POS.  PN(J+4)
50400		MOVEM 3,Q-1(1)		;	PN(J)=3 OR 4
50500		JRST PN1
50600	PN2:	MOVE 3,RCLF	; IF(R.NE.17)GO TO
50700		CAME 3,[17.0]
50800		JRST PN1
50900		MOVE 3,[4.0]	; THE WDCNT
51000		MOVE 2,RCLF+1  	; CLEF #
51100		MOVEM 2,Q+5(1)		;PN(J+6)=CLEF
51200		JRST PN3
51300	PN1:	MOVEM 6,XXX	;LK=LK+1		(6666↑)
51400		MOVE 4,LLL     	;  -L-  XWDS(L)=LK
51500		ADD 4,1(16)	; ADDR. XWDS ARRAY
51600		MOVEM 6,(4)
51700		AOS LLL        ;L=L+1
51800		JRA 16,3(16)
51900	SORT:	0		; CALL SORT(XWDS)
52000		MOVE 11,LLL   	; L
52100		SOJ 11,
52200		MOVEI 4,1		;I=1
52300		MOVE 0,[16.0]
52400		MOVE 1,[8.0]
52500		SETZ 5,		; -K-  DO 243 K=1,L-1
52600	S2:	MOVE 7,(16)	; ADDR. OF XWDS
52700		ADDI 7,(5)			;LB=XWDS(K)+1
52800		MOVE 6,(7)
52900	;;	MOVE 10,Q(6)		;IF(PN(LB).NE.16)GO TO 243
53000	;;	CAME 10,[16.0]
53100		CAME 0,Q(6)
53200		JRST S243
53300	;;	MOVE 10,Q-1(6)		;IF(PN(LB-1).LT.8)GO TO 243
53400	;;	CAMGE 10,[8.0]
53500		CAMLE 1,Q-1(6)
53600	
53700		JRST S243
53800		MOVE 10,-1(7)		;JL=XWDS(K-1)
53900		MOVE 10,Q+2(10)
54000		MOVEM 10,Q+2(6)	;244	PN(LB+2)=PN(JL+3)
54100	S243:	AOJ 5,
54200		CAME 5,11		; -L-1
54300		JRST S2			; 243    CONTINUE
54400	
54500	;; PUTS CONTINUATION OF TEXT IMMEDIATELY AFTER PREV. POS.
54600	;;  FOR SPACING PROBLEMS BELOW.
54700		MOVEI 11,1		;M=2
54800		SETZ 12,		;J=1
54900	S24:	MOVE 13,[100000.0]	;24	RA=100000.;; POSITION
55000		MOVE 1,LLL   		; L
55100		SOJ 1,
55200		SETZ 14,		; -K-
55300	S21:	MOVE 2,(16)		;DO 21 K=1,L-1  - ADDR. OF XWDS -
55400		ADDI 2,(14)		;JL=XWDS(K)+3
55500		MOVE 2,(2)
55600		MOVE 3,Q+2(2)		;R=PN(JL)
55700		CAMN 3,[100000.0]
55800		JRST SX21		;IF(R.EQ.100000)GO TO 21
55900		MOVE 3		;241	IF(ABS(R-RA).GT..1)GO TO 240
56000		FSBR 13
56100		SKIPGE
56200		MOVNS
56300		CAMLE 0,[0.1]
56400		JRST S240
56500		MOVEM 13,Q+2(2)	; ((R=RA))	PN(JL)=R
56600		JRST SX21	;GO TO 21;; PUT IN HERE MULTI-VOICE TRAP SOMEDAY
56700	S240:	CAMLE 3,13		;240	IF(R.GT.RA)GO TO 21
56800		JRST SX21    ;; LINES THEM UP
56900		MOVEI 4,(2)		;	SAVES JL (I=K)
57000		MOVE 13,3  ; RA=R		;21	CONTINUE
57100	SX21:	AOJ 14,		; -K-
57200		CAME 14,1
57300		JRST S21
57400		CAMN 13,[100000.0]	;IF(RA.EQ.100000)GO TO 23
57500		JRA 16,1(16);  JUMP IF ALL SORTED
57600	;;;;	MOVE 10,(16)		;242	JL=XWDS(I)
57700		MOVEI 15,(4)		;LA=JL
57800		KIFIX 1,Q-1(4)		;N=PN(JL)+3
57900		ADDI 1,3		; N
58000		MOVE 2,PTR-1(11)	; PWDS(M)=PWDS(M-1)+N
58100		ADDI 2,(1)
58200		MOVEM 2,PTR(11)
58300		AOJ 11,		;	M=M+1
58400	;;	FIXX(1)			;DO 22 K=J,J+N-1
58500		ADDI 1,(12)		; -J+N-
58600	S22:	MOVE 2,Q-1(4)		;	RN(K)=PN(JL)
58700		MOVEM 2,XRN(12)
58800		AOJ 12,
58900		CAME 12,1
59000		AOJA 4,S22		;22   JL=JL+1
59100		AOJ 4,			; (JL=JL+1)
59200		MOVE 2,[100000.0]	;  PN(LA+3)=100000
59300		MOVEM 2,Q+2(15)		; PUT IT ASIDE
59400		JRST S24	;  	GO TO 24
59500	
59600	SHIFT:	0		; CALL SHIFT
59700		SOS LLL		; (IN MAIN.  L=L-1)
59800		SETZ 2,		;K=1
59900		SETZ 3,		;L=1
60000		SETO 4,		;LK=1  ((LL=0))
60100	SH221:	MOVE 5,PX(2)	;221	IF(Q(IFIX(PN(K))+1))GO TO 321
60200		MOVE 6,Q(5)
60300		JUMPL 6,SH321
60400		MOVE 7,PX+1(2)
60500	SH421:	MOVE 6,Q-1(5)		;DO 421	 KL=IFIX(PN(K)),IFIX(PN(K+1))-1
60600		MOVEM 6,Q(3)	; ((LL=LL+1))421	Q(LL)=Q(KL)
60700		AOJ 5,
60800		CAMGE 5,7
60900		AOJA 3,SH421
61000		AOJ 4,		;LK=LK+1
61100		AOJ 3,
61200		MOVE 1,3		;PN(LK)=LL+1
61300		AOJ 1,
61400		MOVEM 1,PX+1(4)
61500	SH321:	AOJ 2,			;321	K=K+1
61600		CAMGE 2,LLL   	; (L) IF(K.LT.KK)GO TO 221
61700		JRST SH221
61800		AOJ 4,
61900	 	MOVEM 4,LLL   	; L=LK-1  ;; L=NUMBER OF ITEMS FOR RHY RECONS.
62000		JRA 16,(16)
62100	
62200	SHFT1:	0		; CALL SHFT1(KQ)
62300		MOVEI 2,1		; -L-  (KK=1)
62400		MOVEI 6,1		; -K-
62500	SP:	KIFIX 4,Q-1(6)		;220	JJ=Q(K)+3
62600		ADDI 4,3
62700		MOVEM 6,PX-1(2)
62800	;;NEW POINTER
62900		MOVE Q(6)	;IF(Q(K+1).NE.2.OR.Q(K).LT.6)GO TO SPA
63000		CAME [2.0]
63100		JRST SPA
63200		MOVE [6.0]
63300		CAMLE Q-1(6)
63400		JRST SPA
63500		MOVEI 13,(4)	; JJ
63600		ADDI 13,(6)	; +K
63700		MOVE 3,Q(13)	;IF(Q(JJ+1).NE.10.OR.Q(JJ).LT.6)GO TO SPA
63800		CAMN 3,[10.0]
63900		CAMLE Q-1(13)
64000		JRST SPA
64100	
64120		SKIPN IPG		;IF(IPG.EQ.0)GO TO SPA
64140		JRST SPA	;do next only when extracting parts(IPG.NE.0)
64200		SETO 3,		;M=0 (-1)
64300		KIFIX 5,Q-1(13)	; KK=Q(JJ)+2
64400		        	;DO SPB N=K,KK
64500		ADDI 5,2	; KK
64600		MOVEI 7,(6)	; (N=K)
64700		ADDI 5,(7)	; (KK=K+KK+JJ-1)
64800		ADDI 5,(4)
64900	;;	SOJ 5,		; THE TOTAL NUM OF ITEMS TO SCRAMBLE
65000	SPB:	MOVE Q-1(7)	;M=M+1
65100		AOJ 3,		;  M
65200		MOVEM XRN(3)	;SPB	RN(M)=Q(N)
65300		CAIGE 7,(5)
65400		AOJA 7,SPB
65500	
65600		MOVEI 3,(13)	; JJ
65700		SUB 3,6		; M=JJ-K  (-1)
65800		MOVEI 7,(5)	; KK
65900		SUB 7,13		; J=KK-JJ
66000		MOVEI 11,(7)	; KA=J
66100		ADDI 11,(6)	; +K
66200	;;	SOJ 11,		;KA=K+J-1
66300		MOVEI 12,(6)	; N=K
66400		MOVEI 14,(12)
66500		MOVE 15,XRN+3(3)	; SAVE POS (R3)
66600	SPC:	MOVE XRN(3)	;DO SPB N=K,KA
66700		MOVEM Q-1(12)	; M=M+1
66800		AOJ 3,		;SPC	Q(N)=RN(M)
66900		CAIGE 12,(11)
67000		AOJA 12,SPC
67100	
67200		MOVEI 13,(6)	; JJ=K+J
67300		ADDI 13,(7)	; JJ
67400		SETZ 3,		; M=0 
67500		SOJ 5,		; KK-1
67600		MOVE 7,XRN+3(3)	; POS OF THIS ITEM
67700		MOVEM 7,Q+2(14)	;EXCHANGE THEM
67800		MOVEM 15,XRN+3(3)
67900	SPD:	MOVE XRN(3)	;DO SPD N=JJ,KK-1
68000		MOVEM Q(13)	; M=M+1
68100		AOJ 3,		;SPD	Q(N)=RN(M)
68200		CAIGE 13,(5)
68300		AOJA 13,SPD	; ALL THIS TO FIND NUM AFTER WHOLE REST.
68400		JRST SP		;GO BACK TO GET RIGHT PNTRS NOW.
68500				;K=K+JJ
68600	SPA:	ADDI 6,(4)	; -K- (KK=KK+1)
68700		CAMGE 6,@(16)		;IF(K.LT.KQ)GO TO 220
68800	 	AOJA 2,SP
68900		AOJ 2,      		;PN(KK)=K
69000		MOVEM 6,PX-1(2)
69100		MOVEM 2,LLL       ;L=KK
69200		JRA 16,1(16)
69300	
69400	
69500	SHFT0:	0		; CALL SHFT0(KQ)
69600		MOVE 2,LLL   		;  L
69700		MOVE 4,PTR-1(2)
69800		SOJ 4,
69900		MOVE 2,@(16)		;  KQ
70000	;;	SETZ 3,			; K
70100	;;SH32:	MOVE XRN(3)	; DO 32 K=1,IFIX(PWDS(L))-1
70200	;;	MOVEM Q(2)	; KQ=KQ+1
70300	;;	AOJ 3,
70400	;;	CAME 3,4
70500	;;	AOJA 2,SH32
70600	;;	AOJ 2,		; 32  Q(KQ)=RN(K)
70700		HRLZI 3,XRN	; PUT ADDR OF RN IN LEFT HALF
70800		HRRI 3,Q(2)	; ADDR OF NEXT OPEN SLOT OF Q IN RIGHT HALF
70900		ADDI 2,(4)	; TO LOCATE END OF TRANSFER
71000		BLT 3,Q(2)	; THESE REPLACE THE ';;' ABOVE
71100		MOVEM 2,@(16)		; NEW VALUE OF KQ
71200		MOVEI 1
71300		MOVEM LLL   		; L
71400		MOVEM XXX		; LK
71500		JRA 16,1(16)
71600	
71700	PSHFT:	0		; CALL PSHFT(I)
71800		MOVE 6,@(16)
71900		MOVEI 2,1
72000		MOVE 2,PX-1(2)	;	DO 31 NA=1,I
72100		MOVE 3,PX(6)	;	RN(KL)=Q(NA)
72200				; 31	KL=KL+1
72300		MOVE 4,SF		; KL
72400	PS31:	MOVE 5,Q-1(2)
72500		MOVEM 5,XRN-1(4)
72600		AOJ 2,
72700		CAIE 2,(3)
72800		AOJA 4,PS31
72900		AOJ 4,
73000		MOVEM 4,SF		;  PUT BACK NEW VALUE OF KL
73100		JRA 16,1(16)
73200	
73300	;	SUBROUTINE ADDRST(RPOS,XWDS,PN)
73400	;	COMMON /XXX/LK,LP,JY /PTR/PWDS(250),L,LL,I,IX
73500	;	COMMON RS,JA,REST,J2,RQ(18),JX,JR,LX,RDIS
73600	;	DIMENSION XWDS(1),PN(1)
73700	
73800	ADRST:	0		;	PN(LK)=6
73900		MOVE 1,XXX		; LK
74000		MOVE 6,[6.0]		;      CALL ADRST(XWDS,RR)
74100		MOVEM 6,Q-1(1)
74200		MOVE 2,[2.0]	;	PN(LK+1)=2
74300		MOVEM 2,Q(1)
74400	;;	MOVE 13,.COMM.		;	PN(LK+2)=RS
74500		SETZM Q+1(1)
74600		MOVE 3,SHFT1		;	PN(LK+3)=RPOS-1.  (SHFT1 SAVED 'RR')
74700		MOVEM 3,Q+=11(1)	;  SEE (LK+3) BELOW
74800		FSBR 3,[1.0]
74900		MOVEM 3,Q+2(1)
75000		SETZM Q+3(1)		;	PN(LK+4)=0   
75100		SETZM Q+4(1)		;	PN(LK+5)=0   
75200		SETZM Q+5(1)		;	PN(LK+6)=0   
75300		MOVEM 6,Q+6(1)		;	PN(LK+7)=6.  
75400		MOVE 10,[1.0];	PN(LK+8)=-1
75500		MOVNM 10,Q+7(1)
75600	;	LK=LK+9
75700	;	L=L+1
75800	;	XWDS(L)=LK
75900	; NEXT ADDS A BAR LINE
76000		MOVEM 2,Q+=8(1)	;	PN(LK)=2
76100		MOVE [4.0]		;	PN(LK+1)=4
76200		MOVEM Q+=9(1)
76300	;;	MOVEM 13,PX+=10(1)	;	PN(LK+2)=RS
76400		SETZM Q+=10(1)
76500	;	PN(LK+3)=RPOS		(SEE ABOVE)
76600		MOVE 10,@1(16)		;GET BAR LINE INFO
76700		MOVEM 10,Q+=12(1)	;	PN(LK+4)=RR
76800	;	LK=LK+5
76900	;	L=L+1
77000	;	XWDS(L)=LK
77100	;	END
77200		MOVE 2,LLL   		; L
77300		HRRZ 3,(16)		; ADDR OF XWDS
77400		ADDI 3,(2)
77500		ADDI 1,=9
77600		MOVE 4,1
77700		MOVEM 4,(3)		;XWDS(L)=LK
77800		ADDI 4,5
77900		MOVEM 4,1(3)		;XWDS(L+1)=LK
78000		ADDI 2,2
78100		MOVEM 2,LLL   	;L=L+2
78200		ADDI 1,5
78300		MOVEM 1,XXX		;LK=LK+14
78400		JRA 16,2(16)
78500	
78600	STAFF:	0    ;	SUBROUTINE STAFF(P0,P1, P3,P4,P5,P6,P7,P8)
78700	;;	COMMON/XRN/RN(2000) /SF/KL,RT,KP,RSTJ2,NAMX
78800	;;	COMMON /PTR/PWDS(250),L,LL,I,IX
78900		MOVE 2,SF+2	; KP	PWDS(KP)=KL
79000		MOVE 4,SF	; KL
79100		MOVEI 3,(4)
79200		MOVEM 3,PTR-1(2)
79300		AOJ 2,		;	KP=KP+1
79400		MOVEM 2,SF+2
79500		MOVE 2,@(16)	;  RN(KL)=P0
79600		MOVEM 2,XRN-1(4)
79700		MOVE @1(16)	;  RN(KL+1)=P1
79800		MOVEM XRN(4)
79900		MOVE SF+1	;  RN(KL+2)=RT
80000		MOVEM XRN+1(4)
80100		MOVE @2(16)	;  RN(KL+3)=P3
80200		MOVEM XRN+2(4)
80300		MOVE @3(16)	;  RN(KL+4)=P4
80400		MOVEM XRN+3(4)
80500		MOVE @4(16)	;  RN(KL+5)=P5
80600		MOVEM XRN+4(4)
80700		CAMGE 2,[4.0]	;  IF(P0.LT.4.)GO TO 1
80800		JRST ST1
80900		MOVE @5(16)	;  RN(KL+6)=P6
81000		MOVEM XRN+5(4)
81100		MOVE @6(16)	;  RN(KL+7)=P7
81200		MOVEM XRN+6(4)
81300		MOVE @7(16)	;  RN(KL+8)=P8
81400		MOVEM XRN+7(4)
81500		MOVE @=8(16)	;  RN(KL+9)=P9
81600		MOVEM XRN+=8(4)
81700		MOVE @=9(16)	;  RN(KL+10)=P10
81800		MOVEM XRN+=9(4)
81900		MOVE @=10(16)	;  RN(KL+11)=P11
82000		MOVEM XRN+=10(4)
82100		MOVE @=11(16)	;  RN(KL+12)=P12
82200		MOVEM XRN+=11(4)
82300	ST1:	KIFIX 2,2 	;1	KL=KL+P0+3.
82400		ADDI 2,3
82500		ADDM 2,SF
82600		JRA 16,=12(16)		; END
82700	
82800	;;;RIGHT:	0	;	FUNCTION RIGHT(NA,J)
82900	;;	COMMON /PX/PN(1800) /Q/Q(9000)
83000	;;;	MOVE 4,@(16)		;  NA  K=NA+J
83100	;;;	ADD 4,@1(16)		; +J     J IS EITHER +1 OR -1
83200	;;;	MOVE 5,[16.0]
83300	;;;RT1:	MOVE 3,PX-1(4)		; 1	L=PN(K)
83400	;;	MOVE Q(3)		; IF(Q(L+1).NE.16)GO TO 2
83500	;;	CAME [16.0]		; **** CAN'T USE AC2 - USED IN FORTRAN
83600	;;;	CAME 5,Q(3)
83700	;;;	JRST RT2
83800	;;;	ADD 4,@1(16)		; K=K+J
83900	;;;	JRST RT1		; GO TO 1
84000	;;;RT2:	MOVE Q+2(3)		; 2	RIGHT=Q(L+3)
84100	;;;	JRA 16,2(16)		; END
84200	RIGHT:	0		;FUNCTION RIGHT(NA,J,JK)
84300		MOVE 4,@(16)
84400		MOVE 6,4
84500		MOVE 11,@1(16)	; SAVE J IN 11
84600		ADD 4,11	;  K=NA+J      J= +1 OR -1
84700		SKIPLE 4	; IF(K.GT.0)GO TO RT4
84800		JRST RT4
84900		MOVE 0,Q+3	;RIGHT=Q(JK+3)
85000		JRA 16,3(16)	;RETURN
85100	RT4:	MOVEI 5,Q	; Q	R=Q(JK+2)
85200		ADD 5,@2(16)
85300		MOVE 5,1(5)	;R  THE STAFF NUM.
85400		MOVEI 8,1	;JX=1       FOR REVERSE LOOP
85500		SKIPL @1(16)	;IF(J.GT.0)JX=I    FORWARD LOOP
85600		MOVE 8,LLL+2
85700	RT1:	JSA 16,CODEN	;	DO 134 K=NA-1,1,-1
85800		JUMP PX		;	R8=CODEN(KPN,K,Q,LL)
85900		JUMP 4
86000		JUMP Q
86100		JUMP 7		;LL
86200		CAMN 0,[4.0]	;	IF(R8.EQ.4)GO TO 234
86300		JRST RT2
86400		MOVE 3,Q+1(7)	;	IF(Q(LL+2).NE.R)GO TO 134
86500		CAME 3,5
86600		JRST RT3
86700		CAML 0,[10.0]	;	IF(R8.LT.10)GO TO 234
86800	RT3:	CAMN 4,8	;134 	CONTINUE
86900		JRST RT2
87000		ADD 4,11
87100		JRST RT1
87200	RT2:	MOVE 0,Q+2(7)	;	C NOW FOUND ITEM TO LEFT OR RT ON THIS STAFF.
87300		JRA 16,3(16)	;234	RR=Q(LL+3)
87400	
87500	RESTS:	0		;XLFT=0  -- CALL RESTS
87600		SETZ 2,
87700		MOVE 12,[4.0]
87800	
87900		MOVE 13,[16.0]	; TO CATCH WORDS
88000		MOVN 3,[99.0]		;SIG=-99
88100	;;	MOVE 4,3		;CLEF=-99
88200		SETZ 6,		;	REST=0
88300		MOVEI 7,1		;K=1
88400	RX50:	MOVE 10,PX-1(7)		;50	JL=PN(K)
88500		MOVE 11,Q(10)		;R=Q(JL+1)
88600		JUMPN 2,RX5		;IF(XLFT.NE.0)GO TO 5
88700		CAMLE 11,[4.0]		;IF(R.LE.4)XLFT=Q(JL+3)
88800		JRST RX5
88900		MOVE 2,Q+2(10)
89000		MOVEM 2,.COMM.+=13
89100		JRST RX3
89200	RX5:	CAME 11,[17.0]		;5	IF(R.NE.17)GO TO 3
89300		JRST RX3
89400		MOVE 1,Q+4(10)		;IF(Q(JL+5).EQ.SIG)GO TO 60
89500		CAMN 1,3
89600		JRST RX60
89700		MOVE 3,1		;SIG=Q(JL+5)
89800	RX3:	CAME 11,[2.0]		;3	IF(R.NE.2)GO TO 231
89900		JRST RX231
90000		MOVE Q-1(10)		;IF(Q(JL).GE.6)GO TO 7
90100		CAML [6.0]
90200		JRST RX7
90300	
90400		JRST RX231	;NEXT (TO RX7) DOESN'T WORK YET.  NEEDS TO EXPND DATA!
90500	;;	MOVE 1,PX-2(7)		;IF(Q(KPN(K-1))+1).NE.4)GO TO 231
90600	;;	CAMN 12,Q(1)
90700	;;	JRST RX55     ; ANY REST BETWEEN 2 BARS IS A "WHOLE" REST.
90800	;;	CAME 13,Q(1)
90900	;;	JRST RX231	; IF NOT WORDS, JUMP
91000	;;	MOVE 14,PX-3(7)
91100	;;	CAME 12,Q(14)	; IS THIS ONE A BAR?
91200	;;	JRST RX231	; NO
91300	; WON'T CATCH IT IF THERE IS A CLEF, METER, ETC. PRESENT
91400	;;RX55:	MOVE 1,PX(7)		;IF(Q(KPN(K+1))+1).NE.4)GO TO 231
91500	;;	CAME 12,Q(1)
91600	;;	JRST RX231
91700	; FOUND A WHOLE REST MEAS.
91800	
91900	RX8:	MOVE 11,[3.0]	;Q(JR)=3  (P7=3)
92000		MOVE 13,PX-1(7)	;JR=JL+7
92100		ADDI 13,6
92200		CAMLE 12,Q(13)	;IF(Q(JR+1).GT.4)GO TO RX9
92300		JRST RX9
92400		MOVNM 11,Q-3(13)	;Q(JR-2)=-3  P5=-3 =DBL WHOLE REST
92500		MOVE [8.0]	;IF(R.LT.8)GO TO RX9
92600		CAMGE Q(13)
92700		JRST RX9
92800		MOVE 11,Q(13)	;Q(JR-1)=IFIX(R/4.0)+2.0
92900		FDVR 11,12
93000		KIFIX 11,11
93100		FLTR 11,11
93200		FADR 11,[2.0]
93300	RX9:	MOVEM 11,Q(13)
93400		JRA 16,(16)	;RETURN
93500	
93600	RX7:	MOVN Q+7(10)	;IF(Q(JL+8).LE.-4)GO TO 231
93700		CAML [4.0]	;CATCH BAR REPEAT SIGN
93800		JRST RX231
93900		JUMPN 6,RX6		;7	IF(REST.NE.0)GO TO 6
94000		MOVEI 13,(10)		;JR=JL+8
94100		ADDI 13,6
94200	;  POINTER TO REST NUM.
94300		MOVE 11,Q(13)		;R=Q(JR-1)
94400		CAMGE 11,[5.0]		;IF(R.LT.5)R=5
94500		MOVE 11,[5.0]
94600		FMPR 11,[0.6]		;Q(JR-1)=R*.6
94700		MOVEM 11,Q(13)
94800	;  REDUCE SIZE OF REST'S TIME SO IT WILL TAKE LESS SPACE.
94900	RX6:	FADR 6,[1.0]		;6	REST=REST+1
95000		MOVEM 6,Q+1(13)		;Q(JR)=REST
95100		MOVN [2.0]
95200		MOVEM Q-3(13)		;Q(JR-4)=-2  (LOWER THE REST'S POS.)
95300		MOVEI 10,(7)		;JL=K+2
95400		ADDI 10,2
95500		CAML 10,LLL		;IF(JL.GE.L)RETURN
95600		JRA 16,(16)
95700	;;;	JRST RX8
95800		MOVE 14,PX-1(10)	;LB=KPN(JL)
95900		MOVE Q(14)		;IF(Q(LB+1).NE.2)GO TO 233
96000		CAME [2.0]
96100		JRST RX233	; NEXT IS TO COMBINE MEASURES OF REST
96200		MOVE Q-1(14)		;IF(Q(LB).LT.6)GO TO 233
96300		CAMGE [6.0]
96400		JRST RX233
96500	;  SKIP NON-WHOLE RESTS
96600		MOVE 15,PX-2(10)	;N=KPN(JL-1)
96700	;;	MOVE Q(15)		;IF(Q(N+1).NE.4)GO TO 233
96800		CAME 12,Q(15)
96900		JRST RX233
97000	;  IS REST FOLLOWED BY A BAR?	OR RHRSL NUM?(COULD BE A PROB. HERE!!!)
97100	; SO IT WON'T BE FOUND NEXT TIME AROUND.
97200		MOVN	[1.0]		;Q(LB+1)=-1
97300		MOVEM Q(14)    ;  CHANGE CODE #
97400		MOVEM Q(15)		;Q(N+1)=-1 
97500		MOVEI 7,(10)		;K=JL
97600		JRST RX6		;GO TO 6
97700	RX60:	MOVE [1.0]		;60	Q(JL+1)=-1
97800		MOVNM Q(10)
97900		JRST RX231		;GO TO 231
98000	RX233:	SETZ 6,			;233	REST=0
98100	RX231:	AOJ 7,			;231	K=K+1
98200		CAMGE 7,LLL		;IF(K.LT.L)GO TO 50
98300		JRST RX50
98400		JRA 16,(16)		; END
98500	
98600	EXCHG:	0		;CALL EXCHG(MM(J),NN(J))
98700		HRRZI 1,@(16)	; ADDR OF MM(J)
98800		MOVE 2,1(1)	;VALUE OF MM(J+1)
98900		EXCH 2,@(16)	;EXCHANGE
99000		MOVEM 2,1(1)	; MM(J+1)
99100		HRRZI 1,@1(16)	; ADDR OF NN(J)
99200		MOVE 2,1(1)	;VALUE OF NN(J+1)
99300		EXCH 2,@1(16)	;EXCHANGE
99400		MOVEM 2,1(1)	; NN(J+1)
99500		JRA 16,2(16)
99600	
99700	EXCH:	0
99800		MOVE @(16)
99900		EXCH @1(16)
     

00100		MOVEM @(16)
00200		JRA 16,2(16)
00300	
00400	SHRNK:	0		;CALL SHRNK(K,IT)
00500		MOVE 10,@1(16)
00600		MOVE 11,PX(10)	;END OF Q DATA
00700		SOJ 10,
00800		MOVE 2,@(16)	;K
00900		MOVEI 12,(2)
01000		MOVE 3,PX-1(2)	;PTR TO Q(n)
01100		MOVEI 6,(3)	;SAME
01200		MOVE 13,Q+2(3)	;POS. OF CLEF TO BE REMOVED.
01300		MOVE 4,PX(2)	;PTR TO NEXT ITEM
01400		MOVEI 1,(4)	;TO USE IN BLT
01500		SUBI 3,(4)	;WDCCNT OF DELETE ITEM
01600		SUB 4,PX+1(2)	; NEXT +1
01700		SUB 3,4		; AMOUNT OF CHANGE
01800	SK:	MOVE 5,PX+1(2)
01900		SUB 5,PX(2)
02000		ADD 5,PX-1(2)
02100		MOVEM 5,PX(2)
02200		CAIE 2,(10)
02300		AOJA 2,SK
02400		MOVE 2,PX(2)	; LAST PTR
02500		MOVE 7,Q+2(6)	;POS FOR LATER "MOVE"
02600	SK2:	MOVE Q-1(1)
02700		MOVEM Q-1(6)
02800		AOJ 1,
02900		CAIE 1,(11)
03000		AOJA 6,SK2
03100		MOVEM 10,@1(16)
03200		MOVEM 10,LLL+2	;I=LEND (FOR FINAL ENDPOINT)
03300	;;	AOJ 10,		; TO GET TO END OF DATA.
03400		MOVEM 7,.COMM.+5	;R4
03500	SKMV:	SETZM LLL+1	;LL=0 (NO JUSTIFY)
03600		MOVE 2,[200.0]
03700		MOVEM 2,.COMM.+6	;R5
03800		SETZM .COMM.		;RS
03900		MOVEM 2,.COMM.+=10	;R9=R5
04000		SETZM .COMM.+=8		;R7
04100		MOVEM 13,.COMM.+=9	;R8=EXPAND REMAINDER OF LINE TO CLEF POS.
04200		JSA 16,PTMOVE
04300		JUMP Q
04400		JUMP PX-1(12)
04500		JRA 16,2(16)
04600	
04700	EXPND:	0	; TO SHIFT LINE TO RT. WHEN ADDING KSIG.
04800		MOVE 5,[5.0]
04900		MOVE 2,[7.1]
05000		FMPR 2,STF+=8
05100		MOVEM 2,.COMM.+5	;R4=7*RSTJ2+.1
05200		MOVE 12,@(16)	; GET PTR TO PX
05300		ADDI 12,2	; ADD 2 (FOR NOW, ANYWAY)
05400		SETZM .COMM.+=9
05500		JRST SKMV	; GO MOVE IT
05600	
05700	CLFNUM:	0	;X=CLFNUM(Q,PX,MS)  (FUNCTION)
05800		MOVEI 2,@1(16)	;GET PX'S ADDR
05900		ADD 2,@2(16)
06000		MOVE 2,(2)	;PX(MS)
06100		MOVEI 1,@(16)	; ADDR OF Q
06200		ADD 2,1		;ADDR OF Q(PX(MS)+1)
06300		MOVE 5(2)	;X=Q(PX(MS)+5)
06400		MOVE 1,-1(2)
06500		CAMGE 1,[3.0]	;IF (Q( ).LT.3)X=0
06600		SETZ		; ANSWER IN AC0
06700		JRA 16,3(16)
06800	
06900	SLRV:	0		; CALL SLRV(KK,C)
07000		MOVE 1,@(16)	; KK
07100		MOVE 2,@1(16)	; C
07200		FADRM 2,Q+3(1)	; WORKS WITH Q ARRAY ONLY******
07300		FADRM 2,Q+4(1)	; FOR Q(KK+4) AND (KK+5)
07400		MOVNS Q+6(1)	; Q(KK+7)
07500		JRA 16,2(16)
07600	
07700	CLEFN:	0
07800		MOVEI 3,@(16)		;FUNCTION CLEFN(Q,J)
07900		ADD 3,@1(16)	;Q(J+1) NOW
08000		MOVE 2,-1(3)		;IF(Q(J).LT.3)RR=0
08100		SETZ 0,
08200		CAML 2,[3.0]
08300		MOVE 0,4(3)
08400		JRA 16,2(16)
08500	;	CAMGE 0,[100.0]
08600	;	JRA 16,2(16)		;IF(Q(J+5).LT.100)RR=Q(J+5)
08700	;	JSA 16,AMOD
08800	;	JUMP 4(3)		;ELSE RR=AMOD(Q(J+5),100.0)
08900	
09000	MMNN:	0			;CALL MMNN(K)
09100		MOVEI 2,1		;N=N+1
09200		ADDB 2,JN+1		;NN(N)=0
09300		SETZM XRN+=499(2)
09400		MOVE @(16)		;MM(N)=J+K
09500		ADD JN
09600		MOVEM XRN-1(2)
09700		JRA 16,1(16)
09800	
09900	CODEN:	0		;FUNCTION CODEN(K,N,R,M)
10000		MOVE 1,@1(16)	;PNTR TO K ARRAY
10100		SOJ 1,
10200		ADD 1,(16)	;ADD LOC OF K ARRAY
10300		MOVE 1,(1)	;GET PNTR TO R ARRAY
10400		MOVEM 1,@3(16)	;SEND IT BACK IN M
10500		ADD  1,2(16)	;ADD LOC OF R ARRAY
10600		MOVE (1)	;R(M+1)  (CODE NUM OF ITEM)
10700		JRA 16,4(16)
10800		
10900	ZERO:	0  		;FUNCTION ZERO(X,Y)
11000		MOVE @(16)	;ZERO=X-Y
11100		FSBR @1(16)
11200		SKIPGE    	;IF(ABS(ZERO).LT..01)ZERO=0
11300		MOVNS
11400		CAMG 0,[0.01]
11500		SETZ 0,
11600		JRA 16,2(16)	;END
11700	
11800	
11900	; WRITES AND READS DUMP MODE FILES WITH ANY EXTENSION.
12000		CH3←12
12100		CH2←11
12200		BLKS←←=1
12300	
12400	;CALL PUTEXT(<FILE>,<EXT>)
12500	
12600	PUTEXT:	0	;USES EXTOUT,FINEXT, CH2
12700		MOVE 0,@0(16)
12800		MOVEM 0,FILNAM
12900		MOVE 0,@1(16)
13000		MOVEM 0,EXTNAM
13100		JSA 16,INTFIL
13200		SETZM DIR+2
13300		SETZM DIR+3
13400		ENTER CH2,DIR
13500		ERROR <ENTER FAILED>
13600		JRA 16,2(16)
13700	
13800	;CALL EXTOUT(<ARRAY>,<NO. OF WORDS>)
13900	
14000	EXTOUT:	0
14100		HRRZ 0,0(16)
14200		SUBI 0,1
14300		MOVEM 0,COM
14400		MOVN 0,@1(16)
14500		HRLM 0,COM
14600		OUTPUT CH2,COM
14700		STATZ CH2,740000
14800		ERROR <WRITE ERROR>
14900		JRA 16,2(16)
15000	
15100	
15200	INTFIL:	0	;INITS DSK 
15300		MOVEI REGS
15400		BLT REGS+3
15500		INIT CH2,17
15600		SIXBIT/DSK/
15700		0
15800		ERROR <CAN'T INIT DSK!>
15900	EXTF4:	PUSHJ 17,INTF4
16000	;NEXT IS NEAR TOP OF FILE.********
16100	;INTF4:	MOVE 0,FILNAM#
16200	;	MOVEM 0,FN#
16300	;	MOVE 1,[POINT 7,FN]
16400	;INTF3:	MOVE 2,[POINT 6,DIR]
16500	;	SETZM DIR
16600	;	MOVEI 3,5
16700	;INTF1:	ILDB 0,1
16800	;	CAIN 0," "
16900	;	JRST INTF2
17000	;	SUBI 0,40
17100	;	IDPB 0,2
17200	;	SOJG 3,INTF1
17300	;INTF2:	HRLZI REGS
17400	;	BLT 3
17500		MOVE 0,EXTNAM#
17600		MOVEM 0,EX#
17700		MOVE 1,[POINT 7,EX]
17800	EXTF3:	MOVE 2,[POINT 6,DIR+1]
17900		SETZM DIR+1
18000		MOVEI 3,5
18100	EXTF1:	ILDB 0,1
18200		CAIN 0," "
18300		JRST EXTF2
18400		SUBI 0,40
18500		IDPB 0,2
18600		SOJG 3,EXTF1
18700	EXTF2:	HRLZI REGS
18800		BLT 3
18900		JRA 16,0(16)
19000	
19100	
19200	COM:	OCT 0,0
19300	COM1:	0
19400	BLKNUM:	0
19500	
19600	;CALL FINEXT
19700	FINEXT:	0
19800		CLOSE CH2,0
19900		STATZ CH2,740000
20000		ERROR <ERROR AFTER CLOSE>
20100		RELEASE CH2,0
20200		JRA 16,0(16)
20300	
20400	;CALL GETEXT(<FILE>,<EXT>)
20500	
20600	GETEXT:	0
20700		MOVE 0,@0(16)
20800		MOVEM 0,FILNAM
20900		MOVE 0,@1(16)
21000		MOVEM 0,EXTNAM
21100		JSA 16,INTFIZ
21200		SETZM DIR+3
21300		SETZM DIR+2
21400		LOOKUP CH3,DIR
21500		ERROR <LOOKUP FAILED>
21600		JRA 16,2(16)
21700	
21800	
21900	INTFIZ:	0	;INITS DSK FOR INPUT
22000		MOVEI REGS
22100		BLT REGS+3
22200		INIT CH3,17
22300		SIXBIT/DSK/
22400		0
22500		ERROR <CAN'T INIT DSK!>
22600	;;	JRST INTF4
22700		JRST EXTF4
22800	
22900	
23000	;CALL FASTI2(<ARRAY>,<NO. WORDS>)
23100	
23200	EXTIN:	0
23300		HRRZ 0,0(16)
23400		SUBI 0,1
23500		MOVEM 0,COM
23600		MOVN 0,@1(16)
23700		HRLM 0,COM
23800		INPUT CH3,COM
23900		STATZ CH3,740000
24000		0
24100		JRA 16,2(16)
24200	           
24300		END